﻿{ ******************************************************* }
{ }
{ DelphiWebMVC 5.0 }
{ E-Mail:pearroom@yeah.net }
{ 版权所有 (C) 2022-2 苏兴迎(PRSoft) }
{ }
{ ******************************************************* }
unit MVC.DSQuery;

interface

uses
  System.Generics.Collections, FireDAC.Phys.FBDef, FireDAC.Phys.FB, FireDAC.DApt,
  Data.DB, system.Classes, FireDAC.Stan.Intf, FireDAC.Comp.Client, mvc.Config,
  mvc.Tool, system.SysUtils, mvc.LogUnit, System.JSON, mvc.JSON;

type
  TDSQuery = class(TFDQuery)
  private
    function GetB(key: string): boolean;
    function GetD(key: string): TDateTime;
    function GetF(key: string): double;
    function GetI(key: string): integer;
    function GetS(key: string): string;
    procedure SetB(key: string; const Value: boolean);
    procedure SetD(key: string; const Value: TDateTime);
    procedure SetF(key: string; const Value: double);
    procedure SetI(key: string; const Value: integer);
    procedure SetS(key: string; const Value: string);
    function checkType(dbtype: TFieldType): Boolean;
  public
    property S[key: string]: string read GetS write SetS;
    property I[key: string]: integer read GetI write SetI;
    property B[key: string]: boolean read GetB write SetB;
    property D[key: string]: TDateTime read GetD write SetD;
    property F[key: string]: double read GetF write SetF;
    procedure SetValues(map: IJObject);
    function toJSONArray(isFmt: boolean = true): string;
    function toJSONObject(isFmt: boolean = true): string;
    function toJObject:TJSONObject;
    function toAObject:TJSONArray;
  end;

implementation
{ TDSQuery }

function TDSQuery.GetB(key: string): boolean;
begin
  Result := FieldByName(key).value;
end;

function TDSQuery.GetD(key: string): TDateTime;
begin
  Result := FieldByName(key).value;
end;

function TDSQuery.GetF(key: string): double;
begin
  Result := FieldByName(key).value;
end;

function TDSQuery.GetI(key: string): integer;
begin
  Result := FieldByName(key).value;
end;

function TDSQuery.GetS(key: string): string;
begin
  Result := FieldByName(key).value;
end;

procedure TDSQuery.SetB(key: string; const Value: boolean);
begin
  FieldByName(key).Value := Value;
end;

procedure TDSQuery.SetD(key: string; const Value: TDateTime);
begin
  FieldByName(key).Value := Value;
end;

procedure TDSQuery.SetF(key: string; const Value: double);
begin
  FieldByName(key).Value := Value;
end;

procedure TDSQuery.SetI(key: string; const Value: integer);
begin
  FieldByName(key).Value := Value;
end;

procedure TDSQuery.SetS(key: string; const Value: string);
begin
  FieldByName(key).Value := Value;
end;

procedure TDSQuery.SetValues(map: IJObject);
var
  i: Integer;
  key, value: string;
begin

  if self.State in [dsEdit, dsInsert] then
  begin
    for i := 0 to map.O.Count - 1 do
    begin

      try
        key := map.O.Pairs[i].JsonString.Value;
        value := map.O.Pairs[i].JsonValue.Value;
        if Self.Fields.FindField(key) <> nil then
          S[key] := value;
      except
        Continue;
      end;
    end;
  end;
end;

function TDSQuery.checkType(dbtype: TFieldType): Boolean;
begin
  if dbtype in [ftString, ftWideString, ftUnknown, ftWideMemo, ftMemo, ftDate, ftDateTime, ftTime, ftFmtMemo, ftTimeStamp, ftTimeStampOffset] then
  begin
    Result := true;
  end
  else
  begin
    Result := false;
  end;
end;

function TDSQuery.toAObject: TJSONArray;
begin
  Result :=TJArray.Parse(toJSONArray());
end;

function TDSQuery.toJObject: TJSONObject;
begin
  Result :=TJObject.Parse(toJSONObject());
end;

function TDSQuery.toJSONArray(isFmt: boolean): string;
var
  k: Integer;
  ret: string;
  ftype: TFieldType;
  json, item, key, value: string;
begin
  ret := '';
  try
    if IsEmpty or (not Self.Active) then
    begin
      Result := '[]';
      exit;
    end;
    json := '';
    First;
    try
      while not Eof do
      begin
        item := '';
        for k := 0 to Fields.Count - 1 do
        begin
          key := Fields[k].DisplayLabel;
          value := Fields[k].AsString;
          ftype := Fields[k].DataType;
          if Config.JsonFmt <> '' then
            key := IITool.fmtKey(Config.JsonFmt, key);
          if Config.JsonToLower then
            key := key.ToLower;

          if checkType(ftype) then
          begin
            if isFmt then
              value := '"' + IITool.UnicodeEncode(value) + '"'
            else
              value := '"' + IITool.StringFormat(value) + '"'
          end
          else if ftype = ftBoolean then
          begin
            value := value.ToLower;
            if (value = '') or (value = '0') then
              value := 'false'
            else if value = '1' then
              value := 'true';
          end;

          if value = '' then
            value := '0';
          item := item + '"' + key + '"' + ':' + value + ',';
        end;
        item := copy(item, 1, item.Length - 1);
        item := '{' + item + '},';
        json := json + item;
        Next;
      end;
    finally

    end;
    if json.Length > 1 then
      json := copy(json, 1, json.Length - 1);
    json := '[' + json + ']';
    Result := json;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;
end;

function TDSQuery.toJSONObject(isFmt: boolean): string;
var
  k: Integer;
  ftype: TFieldType;
  json, item, key, value: string;
begin
  json := '';
  try
    if IsEmpty or (not self.Active) then
    begin
      Result := '{}';
      exit;
    end;
   // Lock(self);
    Self.BeginBatch(true);
    try
      if not IsEmpty then
      begin
        item := '{';
        for k := 0 to Fields.Count - 1 do
        begin
          key := Fields[k].DisplayLabel;
          value := Fields[k].AsString;
          ftype := Fields[k].DataType;
          if Config.JsonFmt <> '' then
            key := IITool.fmtKey(Config.JsonFmt, key);
          if Config.JsonToLower then
            key := key.ToLower;

          if checkType(ftype) then
          begin
            if isFmt then
              value := '"' + IITool.UnicodeEncode(value) + '"'
            else
              value := '"' + IITool.StringFormat(value) + '"'
          end
          else if ftype = ftBoolean then
          begin
            value := value.ToLower;
            if (value = '') or (value = '0') then
              value := 'false'
            else if value = '1' then
              value := 'true';
          end;

          if value = '' then
            value := '0';
          item := item + '"' + key + '"' + ':' + value + ',';
        end;
        item := copy(item, 1, item.Length - 1);
        item := item + '},';
        json := json + item;
        Next;
      end;
      if json.Length > 1 then
        json := copy(json, 1, json.Length - 1);
      Result := json;
    finally
      Self.EndBatch;
    //  UnLock(self);
    end;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;
end;

end.

